VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsHonQueue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type typeQueueItem
 nNextCount As Long
 clrNext(1 To 7) As Long ':-3
 fNextMass(1 To 7) As Single ':-3
 nFlags As Long
End Type

Private m_tQueue() As typeQueueItem '0-based
Private m_nStart As Long, m_nCount As Long, m_nEnd As Long, m_nMax As Long

Private m_nQueueCount As Long

Private m_nQueuePos(31) As Long
Private m_nFlags(31) As Long
Private m_nInitFlags As Long

'debug only
Friend Property Get ItemCount() As Long
ItemCount = m_nCount
End Property

'debug only
Friend Property Get QueueStart() As Long
QueueStart = m_nStart
End Property

'debug only
Friend Property Get QueueEnd() As Long
QueueEnd = m_nEnd
End Property

'debug only
Friend Property Get QueueMax() As Long
QueueMax = m_nMax
End Property

Friend Function PopQueue(ByVal nQueueIndex As Long, ByRef nNextCount As Long, ByRef clrNext() As Long, ByRef fNextMass() As Single) As Boolean
Dim i As Long
Dim t As typeQueueItem
'///
If nQueueIndex < 0 Or nQueueIndex >= m_nQueueCount Then
 Debug.Assert False
 Exit Function
End If
i = m_nQueuePos(nQueueIndex)
If i = m_nEnd Then Exit Function
'///
t = m_tQueue(i)
t.nFlags = t.nFlags And Not m_nFlags(nQueueIndex)
If t.nFlags = 0 Then
 'remove item
 Debug.Assert i = m_nStart
 m_nStart = m_nStart + 1
 If m_nStart >= m_nMax Then m_nStart = 0
 m_nCount = m_nCount - 1
 Debug.Assert m_nCount >= 0
Else
 m_tQueue(i).nFlags = t.nFlags
End If
'///
i = i + 1
If i >= m_nMax Then i = 0
m_nQueuePos(nQueueIndex) = i
'///
nNextCount = t.nNextCount
For i = 1 To 7
 clrNext(i) = t.clrNext(i)
 fNextMass(i) = t.fNextMass(i)
Next i
PopQueue = True
End Function

Friend Sub PushQueue(ByVal nQueueIndex As Long, ByVal nNextCount As Long, ByRef clrNext() As Long, ByRef fNextMass() As Single)
Dim t As typeQueueItem
Dim i As Long
'///
Debug.Assert m_nQueuePos(nQueueIndex) = m_nEnd
'///
If m_nCount >= m_nMax - 1 Then
 ResizeQueue m_nMax + 256&
 Debug.Assert m_nQueuePos(nQueueIndex) = m_nEnd
End If
'///
t.nNextCount = nNextCount
For i = 1 To 7
 t.clrNext(i) = clrNext(i)
 t.fNextMass(i) = fNextMass(i)
Next i
t.nFlags = m_nInitFlags And Not m_nFlags(nQueueIndex)
m_tQueue(m_nEnd) = t
'///
m_nCount = m_nCount + 1
i = m_nEnd + 1
If i >= m_nMax Then i = 0
m_nEnd = i
m_nQueuePos(nQueueIndex) = i
End Sub

Friend Sub ResizeQueue(ByVal nMax As Long)
Dim t() As typeQueueItem
Dim i As Long, idx As Long
'///
ReDim t(m_nMax - 1)
idx = m_nStart
For i = 0 To m_nCount - 1
 t(i) = m_tQueue(idx)
 idx = idx + 1
 If idx >= m_nMax Then idx = 0
Next i
'///
For i = 0 To m_nQueueCount - 1
 idx = m_nQueuePos(i) - m_nStart
 If idx < 0 Then idx = idx + m_nMax
 m_nQueuePos(i) = idx
 Debug.Assert idx <= m_nCount
Next i
'///
m_tQueue = t
Erase t
ReDim Preserve m_tQueue(nMax - 1)
m_nMax = nMax
m_nStart = 0
m_nEnd = m_nCount
End Sub

Friend Sub Create(ByVal nQueueCount As Long)
Dim i As Long, j As Long
j = 1
For i = 0 To 29
 m_nFlags(i) = j
 j = j + j
Next i
m_nFlags(30) = &H40000000
m_nFlags(31) = &H80000000
'///
If nQueueCount < 1 Then nQueueCount = 1 Else If nQueueCount > 32 Then nQueueCount = 32
Select Case nQueueCount
Case 31
 m_nInitFlags = &H7FFFFFFF
Case 32
 m_nInitFlags = -1
Case Else
 m_nInitFlags = m_nFlags(nQueueCount) - 1
End Select
'///
m_nQueueCount = nQueueCount
Erase m_nQueuePos
m_nStart = 0
m_nEnd = 0
m_nCount = 0
'm_nMax = 8 'debug
m_nMax = 256
ReDim m_tQueue(m_nMax - 1)
End Sub
